R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7
ND=R0
IN=R1

TTY=1
KBD=0
LPT=2

.RESET=2
.RESTART=3
.READ=11
.WAIT=4
.WRITE=12
.INIT=1

.=2000
START:	MOV	#.,SP		; SET UP THE STACK
	IOT
	.WORD	0
	.BYTE	.RESET,0	; RESET THE SYSTEM
	IOT
	.WORD	START
	.BYTE	.RESTART,0	; START OVER WITH AN ^P
	IOT
	.WORD	HELLO
	.BYTE	.WRITE,TTY	; GRECT THE TROOPS
	JSR	PC,GETKBD
	CMPB	#'N,BUFI	; GET A LINE TO SEE IF WE SHOULD USE THE LPT
	BNE	INITLP
	IOT
	.WORD	TTYPE		; INIT SLOT LPT TO A TTY
	.BYTE	.INIT,LPT
	IOT
	.WORD	ODAD
	.BYTE	.WRITE,TTY	; TELL HIM THE FUN LIES IN FOR
	BR	XX1
INITLP:	IOT
	.WORD	OGOOD
	.BYTE	.WRITE,TTY	; TELL HIM I'M HAPPY FOR HIM
	IOT
	.WORD	LPTYPE
	.BYTE	.INIT,LPT	; INIT LPT SLOT TO A LPT
XX1:GO:	IOT
	.WORD	ENTMSG
	.BYTE	.WRITE,TTY	; TELL HIM TO TYPE A PHONE #
	IOT
	.WORD	.-2
	.BYTE	.WAIT,TTY	; WAIT UNTIL MESSAGE GETS OUT
	IOT
	.WORD	START
	.BYTE	.RESTART,0	; IF HE TYPES ^P WE START ALL OVER
	JSR	PC,GETKBD	; WAIT FOR INPUT LINE
	IOT
	.WORD	GO
	.BYTE	.RESTART,0	; ^P WHILE PRINTING RETURNS FOR ANOTHER #
	MOV	#BUFI,R1
	CLR	R0		; COUNT THE # OF DIGITS IN THE #
XX5:	INC	R0
	CMPB	@R1,#015	;CHECK FOR A <CR>
	BEQ	XX2		;EXIT LOOP IF FOUND
	CMPB	@R1,#060	;CHECK LOWER LIMIT
	BLT	XX4		;BRANCH IF NO GOOD
	CMPB	(R1)+,#071	;CHECK UPPER LIMIT
	BGT	XX4		;BRANCH IF NO GOOD
	BR	XX5		;LOOP UNTIL THE END
XX2:	CLR	PAGE		; CLEAR THE PAGE #
	MOV	R0,NPLUS
	DEC	R0
	BEQ	GO		;RESTART IF HE DIDN'T TYPE ANY THING
	MOV	R0,N
	JSR	PC,PUTPG	; GO TO THE NEXT PAGE
	CLR	ND		; ND IS THE CURRENT DIGIT
FC1:	INC	ND		; CLEAR THE TRYS ON THIS NEW DIGIT
	CLRB	NTRY(ND)
FC2:	MOVB	BUFI-1(ND),IN	; PICK UP THE CURRENT DIGIT
	BIC	#177600,IN
	SUB	#60,IN
FC3:	INCB	NTRY(ND)	; CONVERT TO ASCII
	MOV	IN,R2
	ASL	R2
	ASL	R2
	ASL	R2
	ASL	R2
	MOVB	NTRY(ND),R3	; TAKE NTRY(ND) AND THE DIGIT AND LOOK
	ADD	R3,R2		; IN CODE FOR A POSSIBLE SUBSTITUTION
	MOVB	CODE-1(R2),R2
	CMPB	R2,#40
	BEQ	FC4		; IF BLANK PERMUTE NEXT DIGIT TO LEFT
	MOVB	R2,MWORD-1(ND)	; ELSE OUTPUT IN THE CURRENT WORD
	CMP	ND,N		; IF NOT AT LAST POSITION WE'RE NOT DONE
	BLT	FC1
	MOV	N,R2
	CLR	R3
XX3:	INC	R3
	MOVB	MWORD-1(R3),R5
	JSR	PC,PUTCHR	; OUTPUT THE CURRENT CHARACTER
	DEC	R2
	BGT	XX3
	MOV	#40,R5
	JSR	PC,PUTCHR
	JSR	PC,TEST		; TEST IF BUFFER FULL
	BR	FC3		; BRANCH TO SPIN THE LEAST SIGNIFICANT DIGIT
FC4:	DEC	ND		; SET UP TO ADVANCE DIGIT TO LEFT
	BGT	FC2
	JSR	PC,PUTLN	; IF NONE WE ARE DONE
	IOT
	.WORD	FORM
	.BYTE	.WRITE,LPT	; OUTPUT CURRENT LINE PLUS LOTS OF PAPER
	IOT
	.WORD	FORM
	.BYTE	.WRITE,LPT
	JMP	GO		; GO AGAIN CHICKEN HEART!
XX4:	IOT
	.WORD	BRUCE
	.BYTE	.WRITE,TTY
	JMP	GO		;TELL HIM TO TYPE IT AGAIN
GETKBD:	IOT			; KEYBOARD INPUT ROUTINE
	.WORD	INBUF
	.BYTE	.READ,KBD	; READ KBD AND
	IOT
	.WORD	.-2
	.BYTE	.WAIT,KBD	; WAITS FOR COMPLETION
	RTS	PC
ZERO:	MOV	R3,-(SP)	; BLANKS THE OUTPUT BUFFER
	MOV	#80.,-(SP)
	MOV	#BUFO,R3
	MOV	R3,POINT
	MOVB	#40,(R3)+
	DEC	@SP
	BGT	.-6
	TST	(SP)+
	MOV	(SP)+,R3
	RTS	PC
PUTPG:	JSR	R5,SAVE		; EJECTS PAPER
	IOT
	.WORD	FORM
	.BYTE	.WRITE,LPT
	CLR	LINES
	INC	PAGE		; INCREMENTS PAGE #
	MOV	#PAGE,R1
	MOV	#BUFO1+50,R0
	JSR	PC,ITOA
	MOV	#BUFO1,R0
	MOV	#BUFI,R1
	MOVB	(R1)+,(R0)+
	CMPB	#15,-1(R1)
	BNE	.-10
	MOVB	#40,-(R0)
	MOV	#10.,R1
	MOVB	#40,(R0)+
	DEC	R1
	BGT	.-6
	IOT
	.WORD	OUTBF1		; AND TYPES A LEADER
	.BYTE	.WRITE,LPT
	JSR	PC,UNSAVE
	JSR	PC,ZERO
	RTS	PC
PUTCHR:	MOVB	R5,@POINT	; PUTS A CHARACTER IN THE OUTPUT BUFFER
	INC	POINT
	RTS	PC
TEST:	MOV	POINT,R5	; SEES IF THE OUTPUT BUFFER CAN HOLD
	ADD	NPLUS,R5
	SUB	#BUFO+72.,R5	; ANOTHER PHONE # IF NOT PUTS OUT THE
	BLE	.+6
	JSR	PC,PUTLN	; LINE SO FAR GENERATED
	RTS	PC
PUTLN:	MOVB	#15,R5
	JSR	PC,PUTCHR
	MOVB	#12,R5
	JSR	PC,PUTCHR	; OUTPUTS THE CURRENT LINE ON SLOT LPT
	MOV	POINT,R5
	SUB	#BUFO,R5
	MOV	R5,OUTBUF+4
	IOT
	.WORD	OUTBUF
	.BYTE	.WRITE,LPT
	INC	LINES
	CMP	LINES,#50.
	BLT	.+6
	JSR	PC,PUTPG
	IOT
	.WORD	.-2
	.BYTE	.WAIT,LPT	; AND WAITS FOR COMPLETION
	JSR	PC,ZERO
	RTS	PC
SAVE:	MOV	R4,-(SP)	; REGISTER SAVE
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	MOV	R5,PC
UNSAVE:	MOV	14(SP),R5
	MOV	(SP)+,12(SP)	; AND UNSAVE ROUTINES
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RTS	PC
OUTBF1:	.WORD	MG2E-MG2S,0,MG2E-MG2S	; LINE PRINTER HEADER LINE
MG2S:	.ASCII	#			 DIGITAL EQUIPMENT CORPORATION#
	.BYTE	15,12
	.ASCII	#		    PDP-11 TELEPHONE NUMBER ACRONYM GENERATOR#
	.BYTE	15,12,12
	.ASCII	# #
BUFO1=.
QQ=20040
	.WORD	QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ
	.ASCII	/PAGE/
	.WORD	QQ,QQ,QQ,QQ,QQ,QQ,QQ,QQ
	.BYTE	15,12,12,12
MG2E=.
	.EVEN
FORM:	.WORD	4.,0,4.		; FORM FEED FOR LPT
	.BYTE	12,12,12,14
INBUF:	.WORD	12.,0,12.	; KBD INPUT BUFFER
BUFI=.
	.=.+50
OUTBUF:	.WORD	82.,0,80.	; LINE PRINTER OUTPUT BUFFER
BUFO=.
	.=.+80.
HELLO:	.WORD	MG1E-MG1S,0,MG1E-MG1S	; MESSAGE FOR THE TROOPS
MG1S:	.BYTE	15,12
	.ASCII	/HELLO SIR, MADAM, OR MISS./
	.BYTE	15,12
	.ASCII	/I CAN HARDLY TELL FROM IN HERE/
	.BYTE	15,12,12
	.ASCII	/DO WE HAVE A LINE PRINTER TODAY? /
MG1E	=	.
ENTMSG:	.WORD	27.,0,27.	; NUMBER PLEASE
	.BYTE	15,12
	.ASCII	/TELEPHONE NUMBER PLEASE/
	.BYTE	15,12
	.EVEN
ODAD:	.WORD	20.,0,20.	; IF HE HAS A TTY TOO BAD
	.BYTE	15,12
	.ASCII	/O DAD O POOR DAD/
	.BYTE	15,12
	.EVEN
OGOOD:	.WORD	49.,0,49.	; TELL HIM HE'S BEEN GOOD
	.BYTE	15,12
	.ASCII	/DO YOU REALIZE THE FUN YOU'D HAVE WITH A TTY?/
	.BYTE	15,12
	.EVEN
BRUCE:	.WORD	27.,0,27.	;TELL HIM TO TYPE BETTER
	.ASCII	/THAT'S AN UNLISTED NUMBER/
	.BYTE	15,12
	.EVEN
LINES:	.WORD	0
POINT:	.WORD	0
PAGE:	.WORD	0
LPTYPE:	.WORD	7
TTYPE:	.WORD	2
N:	.WORD	0
NPLUS:	.WORD	0
MWORD=.				; CURRENT PHONE #
	.=.+40
NTRY=.			; LIST OF WHERE WE ARE IN EACH DIGITS PERMUTATION
	.=.+40
; THE TABLE CODE CONTAINS THE REPLACEMENTS
; TO BE MADE FOR EACH NUMBER IN THE TELEPHONE #. IT 
; CORRESPONDS TO THE TELEPHONE DIAL IN CURRENT USE.
CODE:	.ASCII	/0               /	; REPLACEMENT FOR 0
	.ASCII	/1               /	; REPLACEMENT FOR 1
	.ASCII	/ABC             /	; REPLACEMENT FOR 2
	.ASCII	/DEF             /	; REPLACEMENT FOR 3
	.ASCII	/GHI             /	; REPLACEMENT FOR 4
	.ASCII	/JKL             /	; REPLACEMENT FOR 5
	.ASCII	/MNO             /	; REPLACEMENT FOR 6
	.ASCII	/PRS             /	; REPLACEMENT FOR 7
	.ASCII	/TUV             /	; REPLACEMENT FOR 8
	.ASCII	/WXY             /	; REPLACEMENT FOR 9
ITOA:	MOV	R0,-(SP)	;SAVE THE DEFA
	CLR	-(SP)		;CLEAR HIGH ORDER WORD
	MOV	@R1,-(SP)	;MOVE THE WORD
	BGE	.+6	;->	;BRANCH IF HIGH ORDER BIT 0
	COM	2(SP)	;  I	;SET ALL BITS IN THE WORD
	MOV	SP,R1	;<-	;SET UP THE SEFA FOR JTOA CALL
	SUB	#14,SP		;EXPAND THE STACK FOR A DESTINATION
	MOV	SP,R0		;LET THE STACK BE THE DESTINATION
	JSR	PC,JTOA		;CALL JTOA FOR THE REAL CONVERSION
	MOV	SP,R1		;SET UP FOR A MOVE TO REAL DEFA
	MOV	20(SP),R0	;RESTORE THE USER'S DEFA
	ADD	#5,R1		;THE FIRST FIVE ARE SPACES
	MOV	#7,R2		;TOTAL OF SEVEN CHARACTERS TO BE MOVED
	MOVB	(R1)+,(R0)+	;<-	;MOVE A CHARACTER
	DEC	R2		;  I	;DECREMENT COUNTER
	BGT	.-4		;->	;BRANCH IF MORE TO DO
	ADD	#22,SP		;REMOVE ALL JUNK FORM THE STACK
	RTS	PC		;RETURN TO THE USER
JTOA:	MOV	R0,-(SP)	;SAVE THE DEFA
	CLR	-(SP)		;THIS IS A SIGN CONTROL WORD
	MOV	(R1)+,R3	;GET THE INTEGER LOW ORDER
	MOV	@R1,R2		;AND HIGH ORDER
	BGE	.+12	;->	;IF NEGATIVE
	NEG	R2	;  I	;REVERSE THE SIGN
	NEG	R3	;  I	;AND ZOT THE SIGN CONTROL
	SBC	R2	;  I	;WORD ON THE STACK
	INC	@SP	;  I
	MOV	#12,R5	;<-
	CLR	R4
	MOV	#-1,-(SP)	;A NEGITIVE NUMBER FOR LATER
M.JA01:	CLR	R0		;ZERO OUT A BUNCH OF REGISTERS
	CLR	R1
	JSR	PC,M.DPID	;DIVIDE BY TEN
	MOV	R1,-(SP)	;PUSH THE REMAINDER
	BIS	R2,R0		;PUT ALL THE BITS
	BIS	R3,R0		;IN ONE REGISTER
	TST	R0		;TEST THE QUOTIENT FOR ZERO
	BNE	M.JA01		;BRANCH IF MORE TO DO
	MOV	SP,R5		;NOW COUNT THE MUMBER OF DIGITS
	INC	R4	;<-
	TST	(R5)+	;  I	;WE HAVE A NEGATIVE NUMBER SOMEWHERE
	BGE	.-4	;->
	DEC	R4		;BE REAL ACCURATE ABOUT THIS
	MOV	#13,R3		;ELEVEN
	SUB	R4,R3		;R3 HAS THE NUMBER OF LEADING SPACES
	DEC	R3		;SAVE ROOM FOR A SIGN
	MOV	2(R5),R0	;RESTORE THE LOST DEFA
M.JA02:	TST	R3		;IS THE COUNT EXAUSTED
	BLE	M.JA03
	MOVB	#40,(R0)+	;INSERT A SPACE (ASCII 040)
	DEC	R3
	BR	M.JA02		;BACK FOR SOME MORE
M.JA03:	TST	@R5
	BEQ	M.JA04
	MOVB	#55,(R0)+	;INSERT MINUS SIGN (ASCII 055)
	BR	M.JA05
M.JA04:	MOVB	#40,(R0)+	;OR A SPACE FOR A SIGN
M.JA05:	ADD	#60,@SP	;<-	;CONVERT TO ASCII
	MOVB	(SP)+,(R0)+;  I	;MOVE TO OUTPUT AREA
	TST	@SP	;  I	;SEE IF WE ARE DONE
	BGE	.-10	;->	;BRANCH IF MORE TO DO
	MOVB	#40,@R0		;FOLLOW BY A TRAILING SPACE
	ADD	#6,SP
	RTS	PC		;RETURN TO THE USER

;	DIVISION UTILITY SUBROUTINE
;	R0-R1-R2-R2=DIVIDEND
;	R4-R5=DIVISOR
;	R0-R1=REMAINDER AFTER DIVISION
;	R2-R3=QUOTIENT AFTER DIVISION
;	ENTER WITH JSR	PC,M.DPID
;
M.DPID:	MOV	#40,-(SP)	;COUNTER FOR DIVISION CYCLES
	MOV	R4,-(SP)	;HIGH ORDER
	MOV	R5,-(SP)	;LOW ORDER DIVISOR TO THE STACK
	NEG	2(SP)		;FORM NEGATIVE
	NEG	@SP		;VERSION OF THE DIVISOR
	SBC	2(SP)
	ADD	@SP,R1
	ADC	R0		;PERFORM THE INITIAL SUBTRACTION
	ADD	2(SP),R0
	BCS	M.DP50		;IF CARRY THEN OVERFLOW HAS OCCURRED
	CLR	-(SP)		;THIS IS A LONGER LASTING CARRY BIT
M.DP40:	ROL	R3
	ROL	R2
	ROL	R1
	ROL	R0
	TST	@SP		;TEST "CARRY" INDICATOR
	BEQ	M.DP41		;IF NO "CARRY" THEN ADD ELSE SUBTRACT
	CLR	@SP		;CLEAR UP FOR NEXT TIME
	ADD	2(SP),R1
	ADC	R0		;ADD -(DIVISOR)
	ADC	@SP		;SET "CARRY" BIT
	ADD	4(SP),R0;<-
	BR	M.DP42
M.DP41:	ADD	R5,R1
	ADC	R0		;ADD +(DIVISOR)
	ADC	@SP		;SET "CARRY" BIT
	ADD	R4,R0	;<-
M.DP42:	ADC	@SP		;SET "CARRY" BIT
M.DP43:	TST	@SP		;TEST THE UPDATE INDICATOR
	BEQ	.+4	;->	;IF ZERO FORGET IT
	INC	R3	;  I	;NO CARRY POSSIBLE HERE
	DEC	6(SP)	;<-	;DECREMENT COUNTER
	BGT	M.DP40		;BRANCH IF MORE TO DO
	ROR	R3
	BCS	M.DP44
	ADD	R5,R1
	ADC	R0
	ADD	R4,R0
	CLC
M.DP44:	ROL	R3
	ADD	#10,SP		;ADJUST STACK BY 5 WORDS
	RTS	PC
M.DP50:	ADD	#6,SP
	SEV			;SET OVERFLOW BIT FOR THE USER
	RTS	PC
	.END	START


                                                                                                                                                                                                                                                                              